PLine ӵ




'***********************************************************************

'Ӷ*********************************************************'
Sub AddPointToPline()
    Dim PL As AcadLWPolyline
    Dim PickPnt As Variant
    'On Error Resume Next
    ThisDrawing.Utility.GetEntity PL, PickPnt, "ѡһ"
    
    Dim P As Variant                                        '߶
    P = PL.Coordinates
    Dim PS As AcadPoint
    Dim PE As AcadPoint
    Set PS = ThisDrawing.ModelSpace.AddPoint(Point3D(P(0), P(1), 0)) 'ɫߵ
    PS.color = acBlue
    Dim L As Integer
    L = UBound(P)
    Set PE = ThisDrawing.ModelSpace.AddPoint(Point3D(P(L - 1), P(L), 0)) 'úɫߵյ
    PE.color = acRed
    
    Dim TempPoint1 As Variant                               'ȡϵһ㣬˵㽫ӵ㣨TempPoint2֮ǰ
    Dim TempPoint2 As Variant                               'ȡһ㣬˵Ҫӵĵ㣬ڶTempPoint1֮
ChongXinXuanZe:
    ThisDrawing.Utility.InitializeUserInput 1, ""
    TempPoint1 = ThisDrawing.Utility.GetPoint(, "ѡߵһ(Ԥӵǰһ): ")
    Dim k As Integer
    Dim I As Integer
    '㲻ǶߵĶ㣬ѡ
    For I = 0 To UBound(P) - 1
        If P(I) = TempPoint1(0) And P(I + 1) = TempPoint1(1) Then k = I + 2: Exit For
    Next
    If k = 0 Then
       ThisDrawing.Utility.Prompt "ѡĵ㲻ǶߵĶѡ" & Chr(13)
       GoTo ChongXinXuanZe
    End If
    
    ThisDrawing.Utility.InitializeUserInput 1, ""
    TempPoint2 = ThisDrawing.Utility.GetPoint(TempPoint1, "ѡҪӵĵ: ")
    '¶ֵ
    Dim P1() As Double
    ReDim P1(UBound(P) + 2)
    '뵽
    For I = 0 To k - 1
        P1(I) = P(I)
    Next
    P1(k) = TempPoint2(0): P1(k + 1) = TempPoint2(1)
    For I = k + 2 To UBound(P) + 2
        P1(I) = P(I - 2)
    Next
    '»ƶ
    Dim XPL As AcadLWPolyline
    Set XPL = ThisDrawing.ModelSpace.AddLightWeightPolyline(P1)
    'ƥ
    XPL.Layer = PL.Layer
    XPL.color = PL.color
    Dim SW As Double
    Dim EW As Double
    For I = 0 To Int(L / 2) - 1
        PL.GetWidth I, SW, EW
        XPL.SetWidth I, SW, EW
    Next
    XPL.SetWidth I, SW, EW
    XPL.SetWidth I + 1, SW, EW
    If PL.Closed = True Then XPL.Closed = True
    'ɾԭĶߺ㼰յ
    PL.Delete
    PS.Delete
    PE.Delete
    
End Sub






Sub L2PL()
    Dim objSelected As Object
    Dim L  As AcadLine
    Dim Pl As AcadLWPolyline
    Dim XuanZeJi As AcadSelectionSet
    Dim i As Long
    Dim P() As Double
    On Error GoTo E
    Set XuanZeJi = ThisDrawing.SelectionSets.Add("xline")
    '˻
    Dim FilterType(0) As Integer
    Dim FilterData(0) As Variant
    FilterType(0) = 0
    FilterData(0) = "line"
    
    ThisDrawing.Utility.Prompt "밴˳ѡ߶:" & Chr(13)
    
    XuanZeJi.SelectOnScreen FilterType, FilterData
    ReDim Preserve P(XuanZeJi.Count * 4 - 1)
    
    'ѡе߶νв
    For Each objSelected In XuanZeJi
        If TypeOf objSelected Is AcadLine Then
            Set L = objSelected
            P(i) = L.StartPoint(0)
            P(i + 1) = L.StartPoint(1)
            P(i + 2) = L.EndPoint(0)
            P(i + 3) = L.EndPoint(1)
            i = i + 4
        Else
            'ɾѡ
            ThisDrawing.SelectionSets.item("xline").Delete
        End If
    Next
    Set Pl = ThisDrawing.ModelSpace.AddLightWeightPolyline(P)
    For i = 0 To XuanZeJi.Count * 2 - 1
        Pl.SetWidth i, 1, 1
    Next i
    ThisDrawing.SelectionSets.item("xline").Delete
    ThisDrawing.Application.Update
    Exit Sub
E:
        ThisDrawing.SelectionSets.item("xline").Delete

End Sub



ӭתأת[ݲwww.tiancao.net] ԭӣhttp://www.tiancao.net/blogview.asp?logID=171&cateID=3